home *** CD-ROM | disk | FTP | other *** search
Oberon Text | 1990-01-01 | 20.2 KB | 638 lines |
- Syntax10.Scn.Fnt
- Syntax10i.Scn.Fnt
- MODULE RXA; (* Andreas Margelisch, 1990 *)
- IMPORT Texts, SYSTEM;
- CONST
- tab = 9; cr = 13; blank = 32; dq = 34;
- (* values for tokenval *)
- shorthand = -1;
- metasymbol = -2;
- literal = -3;
- msalternation = -4;
- msopenpar = -5;
- msclosepar = -6;
- msopenquo = -7;
- msclosequo = -8;
- mssubexpr = -9;
- mult = 4;
- nofSET = MAX(SET) + 1;
- nofpos = mult * nofSET;
- nofstates = 128;
- nofchar = 134;
- nofsubexpr = 10;
- undefined= - 1;
- inoffset = 10;
- endoffset = 20;
- spezchar = 134;
- (* Error Codes : errorcode >= 0 means CHR(errorval) expected *)
- noerror* = 0; (* Kein Fehler *)
- noposfree* = -1; (* position array ist voll *)
- nostatesfree* = -2; (* states array ist voll *)
- nometaexp* = -3; (* Unerwartetes Metasymbol gefunden *)
- chrleft* = -4; (* Mindestens eine schliessende Klammer ")", "]", "}" zuviel *)
- wsubexpr* = -5; (* Falscher Teilausdruck-Identifier *)
- subexprrest* = -6; (* Teilausdruck von { }-Klammernpaar umgeben *)
- wshorthand* = -7; (* Falscher Abk
- rzungs-Identifier *)
- notnotexp* = -8; (* Notoperator kann nicht angewendet werden *)
- nodfa* = -9; (* Replace unm
- glich, da kein DFA vorhanden *)
- repllinefull* = -10; (* Parameter line bei Replace ist voll *)
- linecopofl* = -11; (* Interne Variable linecop in Prozedur Replace ist zu klein *)
- TYPE PosSet = ARRAY (mult) OF SET;
- NodePtr = POINTER TO Node;
- Node = RECORD
- pos : INTEGER;
- ch : CHAR;
- nullable : BOOLEAN;
- first, last : PosSet;
- nextl, nextr : NodePtr
- END;
- PosDesc = RECORD
- ch : CHAR;
- shorthand, notoperator : BOOLEAN;
- follow : PosSet
- END;
- PosArray = ARRAY(nofpos) OF PosDesc;
- SubExprDesc = RECORD
- nodeptr : NodePtr;
- spos, epos : INTEGER;
- follow : PosSet
- END;
- DFASubExprDesc = RECORD
- set : BOOLEAN;
- beg, end : INTEGER
- END;
- TransDesc = RECORD
- state : INTEGER;
- subset : SET
- END;
- DFA* = POINTER TO DFADesc;
- DFADesc = RECORD
- nofst : INTEGER;
- subdetect : BOOLEAN;
- trans : ARRAY (nofstates),(nofchar+1) OF TransDesc;
- accepted : ARRAY (nofstates) OF BOOLEAN;
- sub : ARRAY (nofsubexpr) OF DFASubExprDesc
- END;
- Line = ARRAY MAX( INTEGER ) OF CHAR;
- LinePtr = POINTER TO Line;
- rxl : LinePtr;
- rxpos, tokenval, treepos, errorvar, countflag : INTEGER;
- lookahead : CHAR;
- pd : POINTER TO PosArray;
- subexpr : ARRAY (nofsubexpr) OF SubExprDesc;
- subdetect, notflag, inkleene, inquotes, first : BOOLEAN;
- (* set operations for TYPE PosSet *)
- PROCEDURE PSEmpty( VAR set : PosSet );
- VAR i : INTEGER;
- BEGIN
- i := 0; WHILE i < mult DO set[i] := {}; INC(i) END
- END PSEmpty;
- PROCEDURE PSIsEmpty( set : PosSet ) : BOOLEAN;
- VAR i : INTEGER;
- BEGIN
- i := 0; WHILE i < mult DO IF set[i] # {} THEN RETURN FALSE END; INC(i) END;
- RETURN TRUE
- END PSIsEmpty;
- PROCEDURE PSIsEqual( set1, set2 : PosSet ) : BOOLEAN;
- VAR i : INTEGER;
- BEGIN
- i := 0; WHILE i < mult DO IF set1[i] # set2[i] THEN RETURN FALSE END; INC(i) END;
- RETURN TRUE
- END PSIsEqual;
- PROCEDURE PSIn( set : PosSet; v : INTEGER ) : BOOLEAN;
- BEGIN
- RETURN ( v MOD nofSET ) IN set[v DIV nofSET]
- END PSIn;
- PROCEDURE PSIncl( VAR set : PosSet; v : INTEGER );
- BEGIN
- INCL( set[v DIV nofSET], v MOD nofSET )
- END PSIncl;
- PROCEDURE PSUnion( set1, set2 : PosSet; VAR resset : PosSet );
- VAR i : INTEGER;
- BEGIN
- i := 0; WHILE i < mult DO resset[i] := set1[i] + set2[i]; INC(i) END
- END PSUnion;
- PROCEDURE GetChar(): CHAR;
- VAR ch: CHAR;
- BEGIN
- ch := rxl[rxpos];
- CASE countflag OF
- 0 : IF (ch = 0X) OR (rxpos >= LEN(rxl^) ) THEN INC( countflag ); RETURN ")"
- ELSE INC(rxpos); RETURN ch
- END |
- 1 : INC( countflag ); RETURN ("#") |
- ELSE
- IF errorvar = chrleft THEN errorvar := noerror END; RETURN("#")
- END
- END GetChar;
- PROCEDURE SetPosition ( ptr : NodePtr; chr : CHAR );
- BEGIN
- IF treepos < nofpos THEN
- ptr.pos := treepos;
- PSIncl( ptr.first, treepos );
- PSIncl( ptr.last, treepos );
- ptr.nullable := FALSE;
- pd[treepos].ch := chr;
- pd[treepos].shorthand := tokenval = shorthand;
- pd[treepos].notoperator := notflag;
- PSEmpty(pd[treepos].follow);
- INC(treepos)
- ELSE
- errorvar := noposfree
- END
- END SetPosition;
- PROCEDURE NewNode( VAR ptr : NodePtr );
- BEGIN
- NEW(ptr);
- PSEmpty(ptr.first);
- PSEmpty(ptr.last);
- ptr.nextr := NIL;
- ptr.nextl := NIL;
- ptr.ch := lookahead;
- CASE tokenval OF
- literal : SetPosition( ptr, ptr.ch ) |
- shorthand : SetPosition( ptr, ptr.ch )
- ELSE (* metasymbol *)
- ptr.pos := metasymbol
- END;
- notflag := FALSE
- END NewNode;
- PROCEDURE LexAn():CHAR;
- VAR ch : CHAR;
- BEGIN
- ch := GetChar();
- IF ~inquotes THEN WHILE (ORD(ch) = blank) OR (ORD( ch ) = cr ) OR ( ORD( ch ) = tab ) DO ch := GetChar() END END;
- IF ~first & ( ORD(ch) = dq ) THEN inquotes := ~inquotes;
- IF inquotes THEN first := TRUE; tokenval := msopenquo ELSE tokenval := msclosequo END
- ELSE
- IF inquotes THEN
- tokenval := literal; first := FALSE
- ELSE
- CASE ch OF
- "A", "a", "b", "c", "d", "h", "i", "l", "o", "t", "w" : tokenval := shorthand |
- "X" : ch := GetChar(); tokenval := mssubexpr;
- IF ( ch < "0" ) OR ( ch > "9" ) THEN errorvar := wsubexpr END |
- "{", "(", "[" : tokenval := msopenpar |
- "}", ")", "]" : tokenval := msclosepar |
- "|" : tokenval := msalternation |
- "~" : notflag := ~notflag; ch := LexAn();
- IF ( tokenval # msopenquo ) & ( tokenval # shorthand ) THEN errorvar := notnotexp END
- ELSE
- tokenval := literal;
- IF (ch # "#") OR ( countflag = 0 ) THEN errorvar := wshorthand END
- END
- END;
- END;
- RETURN ch
- END LexAn;
- PROCEDURE Match( ch : CHAR );
- BEGIN
- IF ( errorvar = chrleft ) OR ( errorvar = noerror ) THEN
- IF lookahead = ch THEN
- lookahead := LexAn()
- ELSE
- errorvar := ORD(ch)
- END
- END;
- END Match;
- PROCEDURE InitSubExpr( ptr : NodePtr; spos : INTEGER; kleenef : BOOLEAN );
- VAR ind : INTEGER;
- BEGIN
- IF kleenef THEN
- errorvar := subexprrest
- ELSE
- subdetect := TRUE;
- ind := ORD(lookahead) - ORD("0");
- Match( lookahead );
- subexpr[ind].nodeptr := ptr;
- subexpr[ind].spos := spos;
- subexpr[ind].epos := treepos;
- PSEmpty( subexpr[ind].follow )
- END InitSubExpr;
- PROCEDURE^ Term( VAR ptr : NodePtr );
- PROCEDURE^ Factor( VAR ptr : NodePtr );
- PROCEDURE RegExpr( VAR ptr : NodePtr );
- VAR np : NodePtr;
- BEGIN
- Term( ptr );
- WHILE ( tokenval = msalternation ) & (errorvar = chrleft) DO
- NewNode( np );
- Match( "|" );
- np.nextl := ptr;
- ptr := np;
- Term( ptr.nextr )
- END RegExpr;
- PROCEDURE Term( VAR ptr : NodePtr );
- VAR np : NodePtr; tv : INTEGER; lh : CHAR;
- BEGIN
- Factor( ptr );
- WHILE ( tokenval # msclosepar ) & ( tokenval # msclosequo ) & ( tokenval # msalternation ) & (errorvar = chrleft ) DO
- tv := tokenval; lh := lookahead;
- tokenval := metasymbol;
- lookahead := "u";
- NewNode( np );
- tokenval := tv; lookahead := lh;
- np.nextl := ptr;
- ptr := np;
- Factor( ptr.nextr )
- END Term;
- PROCEDURE Factor( VAR ptr : NodePtr );
- VAR tpos : INTEGER;
- kleenef, not : BOOLEAN;
- BEGIN
- kleenef := inkleene;
- tpos := treepos;
- CASE tokenval OF
- msopenpar :
- CASE lookahead OF
- "{" : inkleene := TRUE; NewNode( ptr ); Match( "{" ); ptr.ch := "{"; RegExpr( ptr.nextl ); Match( "}" );
- inkleene := FALSE |
- "[" : NewNode( ptr ); Match( "[" ); ptr.ch := "["; RegExpr( ptr.nextl ); Match( "]" ) |
- "(" : Match( "(" ); RegExpr( ptr ); Match( ")" )
- ELSE
- END |
- msopenquo : not := notflag; Match(CHR(dq)); RegExpr( ptr ); Match(CHR(dq));
- IF not & ( treepos - tpos > 1 ) THEN errorvar := notnotexp END |
- shorthand, literal : NewNode( ptr ); Match( lookahead )
- ELSE errorvar := nometaexp
- END;
- IF ( errorvar = chrleft ) & ( tokenval = mssubexpr ) THEN InitSubExpr( ptr, tpos, kleenef ) END
- END Factor;
- PROCEDURE CalcFiLa( ptr : NodePtr );
- BEGIN
- IF ( ptr.nextl # NIL ) & (ptr.nextl.pos = metasymbol) THEN CalcFiLa( ptr.nextl ) END;
- IF ( ptr.nextr # NIL ) & (ptr.nextr.pos = metasymbol) THEN CalcFiLa( ptr.nextr ) END;
- CASE ptr.ch OF
- "|" : ptr.nullable := ptr.nextl.nullable OR ptr.nextr.nullable;
- PSUnion(ptr.nextl.first, ptr.nextr.first, ptr.first);
- PSUnion(ptr.nextl.last, ptr.nextr.last, ptr.last) |
- "{", "[" : ptr.nullable := TRUE;
- ptr.first := ptr.nextl.first;
- ptr.last := ptr.nextl.last |
- "u" : ptr.nullable := ptr.nextl.nullable & ptr.nextr.nullable;
- ptr.first := ptr.nextl.first;
- IF ptr.nextl.nullable THEN PSUnion(ptr.first,ptr.nextr.first, ptr.first) END;
- ptr.last := ptr.nextr.last;
- IF ptr.nextr.nullable THEN PSUnion(ptr.last,ptr.nextl.last, ptr.last )END
- END CalcFiLa;
- PROCEDURE CalcFollow( ptr : NodePtr );
- VAR j : INTEGER;
- BEGIN
- IF ( ptr.nextl # NIL ) & (ptr.nextl.pos = metasymbol) THEN CalcFollow( ptr.nextl ) END;
- IF ( ptr.nextr # NIL ) & (ptr.nextr.pos = metasymbol) THEN CalcFollow( ptr.nextr ) END;
- CASE ptr.ch OF
- "{" :
- j := 0;
- WHILE j < treepos DO
- IF PSIn( ptr.last, j )THEN PSUnion(pd[j].follow, ptr.first, pd[j].follow )END;
- INC(j)
- END | (* WHILE*)
- "u" :
- j := 0;
- WHILE j < treepos DO
- IF PSIn( ptr.nextl.last, j ) THEN PSUnion( pd[j].follow, ptr.nextr.first, pd[j].follow ) END;
- INC(j)
- END (* WHILE*)
- ELSE (* alternation *)
- END CalcFollow;
- PROCEDURE CalcFollowSubExpr;
- VAR i, j : INTEGER;
- BEGIN
- i := 0;
- WHILE i < nofsubexpr DO
- IF subexpr[i].nodeptr # NIL THEN
- j := 0;
- WHILE j < treepos DO
- IF PSIn( subexpr[i].nodeptr.last, j ) THEN PSUnion( subexpr[i].follow, pd[j].follow, subexpr[i].follow ) END;
- INC(j)
- END
- END;
- INC(i)
- END; (* WHILE*)
- END CalcFollowSubExpr;
- PROCEDURE SetState( dfa : DFA; set : PosSet; VAR ind : INTEGER; VAR ps : ARRAY OF PosSet );
- VAR i, k : INTEGER;
- BEGIN
- ind := 0;
- WHILE ind < dfa.nofst DO
- IF PSIsEqual( ps[ind], set ) THEN RETURN ELSE INC(ind) END
- END;
- IF dfa.nofst < nofstates THEN
- ps[dfa.nofst] := set;
- dfa.accepted[dfa.nofst] := PSIn( set, treepos -1 );
- IF ( dfa.accepted[dfa.nofst] ) & subdetect THEN
- k := 0;
- WHILE k < nofsubexpr DO
- IF subexpr[k].nodeptr # NIL THEN
- IF PSIsEqual( subexpr[k].follow, ps[dfa.nofst] ) THEN INCL( dfa.trans[ dfa.nofst, spezchar].subset, k + endoffset ) END
- END;
- INC(k)
- END
- END;
- i := 0; WHILE i < nofchar DO dfa.trans[dfa.nofst, i].state := undefined; dfa.trans[dfa.nofst, i].subset := {}; INC(i) END;
- INC( dfa.nofst )
- ELSE
- errorvar := nostatesfree
- END SetState;
- PROCEDURE ChrIn( sid : CHAR; ch : INTEGER; short : BOOLEAN ) : BOOLEAN;
- BEGIN
- IF short THEN
- CASE sid OF
- "A" : RETURN ( ORD("A") <= ch ) & ( ch <= ORD("Z")) |
- "a" : RETURN ( ORD("a") <= ch ) & ( ch <= ORD("z")) |
- "b" : RETURN ( ORD("0") <= ch ) & ( ch <= ORD("1")) |
- "c" : RETURN ( ch = cr ) |
- "d" : RETURN ( ORD("0") <= ch ) & ( ch <= ORD("9")) |
- "h" : RETURN ( ChrIn( "d", ch, TRUE )) OR (( ORD("A") <= ch ) & ( ch <= ORD("F"))) |
- "i" : RETURN ChrIn( "l", ch, TRUE ) OR ChrIn( "d", ch, TRUE ) |
- "l" : RETURN ( ChrIn( "A", ch, TRUE ) ) OR ( ChrIn( "a", ch, TRUE ) ) |
- "o" : RETURN ( ORD("0") <= ch ) & ( ch <= ORD("7")) |
- "t" : RETURN ( ch = tab ) |
- "w" : RETURN ( ch = tab ) OR ( ch = cr ) OR ( ch = blank )
- ELSE RETURN FALSE
- END
- ELSE RETURN sid = CHR( ch )
- END ChrIn;
- PROCEDURE CalcStates( dfa : DFA; anchor : NodePtr );
- VAR j, k, ind, unmark, index : INTEGER;
- ps : ARRAY (nofstates) OF PosSet;
- compstates : ARRAY (nofchar) OF PosSet;
- ch : CHAR;
- not, short : BOOLEAN;
- hset, set : SET;
- PROCEDURE HandleSubExpr( pos : INTEGER ) : SET;
- VAR set : SET;
- insub : BOOLEAN;
- k : INTEGER;
- BEGIN
- set := {}; k := 0;
- WHILE k < nofsubexpr DO
- IF subexpr[k].nodeptr # NIL THEN
- insub := ( subexpr[k].spos <= pos ) & ( pos < subexpr[k].epos );
- IF PSIn( subexpr[k].nodeptr.first, pos ) THEN INCL( set, k ) END;
- IF insub THEN INCL( set, k + inoffset ) END;
- IF ~insub & PSIn( subexpr[k].follow, pos ) THEN INCL( set, k + endoffset ) END
- END;
- INC(k)
- END;
- RETURN set
- END HandleSubExpr;
- BEGIN
- dfa.nofst := 0; unmark := 0; j := 0;
- WHILE j < nofchar DO PSEmpty( compstates[j] ); INC(j) END;
- SetState( dfa, anchor.first, ind, ps );
- WHILE unmark < dfa.nofst DO
- j := 0;
- WHILE j < treepos DO
- IF PSIn( ps[unmark], j ) THEN
- not := pd[j].notoperator; short := pd[j].shorthand;
- IF short OR not THEN
- k := 0; ch := pd[j].ch; first := TRUE;
- WHILE k < nofchar DO
- IF ( ~ChrIn( ch, k, short ) & not ) OR ( ChrIn( ch, k, short ) & ~not ) THEN
- IF subdetect THEN
- IF first THEN set := HandleSubExpr( j ); first := FALSE END;
- hset := dfa.trans[unmark, k].subset; hset := set + hset; dfa.trans[unmark, k].subset := hset
- END;
- PSUnion( compstates[k], pd[j].follow, compstates[k] )
- END;
- INC(k)
- END
- ELSE
- index := ORD(pd[j].ch);
- IF subdetect THEN
- hset := dfa.trans[unmark, index].subset; hset := HandleSubExpr( j ) + hset; dfa.trans[unmark, index].subset := hset
- END;
- PSUnion( compstates[index], pd[j].follow, compstates[index] )
- END
- END;
- INC(j)
- END;
- j := 1; (* CHR(0) is reserved for EOS *)
- WHILE j < nofchar DO
- IF ~PSIsEmpty(compstates[j]) THEN
- SetState( dfa, compstates[j], ind, ps );
- dfa.trans[unmark, j].state := ind;
- PSEmpty( compstates[j] )
- END;
- INC(j)
- END;
- INC(unmark)
- END CalcStates;
- PROCEDURE Dump*( dfa : DFA; VAR w : Texts.Writer );
- (* Druckt den zu dfa geh
- rigen Automaten im System.Log Viewer aus. *)
- VAR i, j : INTEGER;
- BEGIN
- Texts.WriteLn( w ); Texts.WriteString(w, " D F A "); Texts.WriteLn( w ); Texts.WriteLn( w );
- i := 0;
- WHILE i < dfa.nofst DO
- IF dfa.accepted[i] THEN Texts.WriteString( w, "accepted ") ELSE Texts.WriteString(w, "not accepted ") END;
- Texts.WriteString(w, "State "); Texts.WriteInt(w, i, 3); Texts.WriteString(w, " : "); Texts.WriteLn( w );
- j := 0;
- WHILE j < nofchar DO
- IF dfa.trans[i,j].state # undefined THEN
- Texts.WriteString(w, "( chr = "); Texts.Write(w, CHR(j)); Texts.WriteString(w, ", ORD = "); Texts.WriteInt(w, j, 4 );
- Texts.WriteString(w, ", newstate = "); Texts.WriteInt(w, dfa.trans[i,j].state,2); Texts.WriteString(w, " )");
- Texts.WriteLn( w )
- END;
- INC(j)
- END;
- Texts.WriteLn( w );
- INC(i)
- END;
- Texts.WriteString( w, "end of dump" ); Texts.WriteLn( w )
- END Dump;
- PROCEDURE New*( rx : ARRAY OF CHAR; VAR dfa : DFA; VAR error, pos : INTEGER);
- Konstruiert den passenden deterministischen endlichen Automaten dfa zum regul
- ren Ausdruck rx.
- error > 0 : character ( CHR( error ) ) wird an der Position pos in rx verlangt.
- error = 0 : Automat konstruiert.
- error < 0 : error enth
- lt den Wert der entsprechenden Fehlerkonstante des in rx an der
- Position pos aufgetretenen Fehlers.
- i : INTEGER;
- anchor : NodePtr;
- BEGIN
- NEW( dfa );
- NEW( pd );
- i := 0; WHILE i < nofsubexpr DO subexpr[i].nodeptr := NIL; INC(i) END;
- rxpos := 0;
- treepos := 0;
- countflag := 0;
- errorvar := chrleft;
- subdetect := FALSE; notflag := FALSE; inkleene := FALSE; inquotes := FALSE; first := FALSE;
- rxl := SYSTEM.VAL( LinePtr, SYSTEM.ADR(rx) );
- lookahead := "(";
- tokenval := msopenpar;
- anchor := NIL;
- RegExpr( anchor );
- IF inquotes THEN errorvar := dq END;
- IF errorvar = noerror THEN
- CalcFiLa( anchor );
- CalcFollow( anchor );
- IF subdetect THEN CalcFollowSubExpr END;
- CalcStates( dfa, anchor );
- dfa.subdetect := subdetect;
- i := 0;
- WHILE i < nofsubexpr DO dfa.sub[i].set := subexpr[i].nodeptr # NIL; INC(i) END
- END;
- rxl := NIL;
- anchor := NIL;
- error := errorvar;
- IF error # noerror THEN pos := rxpos; dfa := NIL; RETURN END
- END New;
- PROCEDURE Search*( dfa : DFA; line : ARRAY OF CHAR; VAR beg, end : INTEGER );
- Sucht in line ab der Position beg den durch dfa bestimmten regul
- ren Ausdruck.
- end >= 0 : [beg, end[ ist der erste ( ab Suchposition beg ) und l
- ngste Bereich, der dem
- gesuchten regl
- ren Ausdruck entspricht.
- end < 0 : Regul
- rer Ausdruck in line nicht gefunden.
- VAR state, i, pos, ch : INTEGER;
- len : LONGINT;
- block : ARRAY( nofsubexpr ) OF BOOLEAN;
- PROCEDURE SavePos( subset : SET; state : INTEGER );
- VAR i : INTEGER;
- BEGIN
- i := 0;
- WHILE i < nofsubexpr DO
- IF ( ~ block[i] ) & ( state # undefined ) THEN
- IF ( i IN subset ) & ( dfa.sub[i].beg = undefined ) THEN dfa.sub[i].beg := pos END;
- IF ~block[i] & ( dfa.sub[i].beg # undefined ) THEN
- IF ( i + endoffset IN subset ) THEN
- dfa.sub[i].end := pos
- ELSIF dfa.accepted[state] & (i + endoffset IN dfa.trans[state, spezchar].subset ) THEN
- dfa.sub[i].end := pos + 1
- END
- END;
- IF ( dfa.sub[i].beg # undefined ) & (~( i + inoffset IN subset ) ) THEN
- IF dfa.sub[i].end = undefined THEN dfa.sub[i].beg := undefined ELSE block[i] := TRUE END
- END
- END;
- INC(i)
- END
- END SavePos;
- PROCEDURE SearchRX( subexp : BOOLEAN );
- BEGIN
- len := LEN(line);
- end := undefined;
- WHILE ( end = undefined ) & ( beg < len ) & ( line[beg] # 0X) DO
- pos := beg;
- state := 0;
- LOOP
- ch := ORD(line[pos]);
- IF dfa.accepted[state] THEN end := pos END;
- IF ( pos >= len) OR (ch = 0) THEN EXIT END;
- IF subexp THEN SavePos( dfa.trans[state, ch].subset, dfa.trans[state, ch].state ) END;
- state := dfa.trans[state, ch].state;
- IF state = undefined THEN EXIT END;
- INC(pos)
- END; (* LOOP *)
- INC(beg)
- END;
- DEC(beg)
- END SearchRX;
- BEGIN
- IF dfa # NIL THEN
- SearchRX( FALSE );
- IF dfa.subdetect & ( end # undefined ) THEN
- i := 0;
- WHILE i < nofsubexpr DO dfa.sub[i].beg := undefined; dfa.sub[i].end := undefined; block[i] := ~dfa.sub[i].set; INC(i) END;
- SearchRX( TRUE )
- END
- END;
- END Search;
- PROCEDURE Replace*( dfa : DFA; VAR line : ARRAY OF CHAR; replpat : ARRAY OF CHAR;
- beg, end : INTEGER; VAR error, pos : INTEGER );
- Ersetzt das St
- ck [beg, end[ in line durch replpat. linecop muss eine Kopie von line sein.
- error > 0 : character ( CHR( error ) ) wird an der Position pos in replpat verlangt. line bleibt unver
- ndert.
- error = 0 : replace erfolgreich, das St
- ck [beg, end[ in line wurde durch ein St
- ck [beg, pos[
- ersetzt.
- error < 0 : error enth
- lt den Wert der entsprechenden Fehlerkonstante des in replpat an der
- Position pos aufgetretenen Fehlers. line bleibt unver
- ndert.
- CONST noofchar = 1024;
- VAR lineind, replind, ind, spos : INTEGER;
- ch : CHAR;
- EORPL, linefull, first, inquotes : BOOLEAN;
- linecop : ARRAY (noofchar) OF CHAR;
- PROCEDURE GetCh() : CHAR;
- VAR ch : CHAR;
- BEGIN
- ch := replpat[replind];
- IF (replind < LEN( replpat ) ) & (ch # 0X) THEN EORPL := FALSE; INC(replind) ELSE EORPL := TRUE END; RETURN ch
- END GetCh;
- PROCEDURE LexAn():CHAR;
- VAR ch : CHAR;
- BEGIN
- ch := GetCh();
- IF ~inquotes THEN WHILE (ORD(ch) = blank) OR (ORD(ch) = cr ) OR (ORD(ch) = tab) DO ch := GetCh() END END;
- IF ~first & ( ORD( ch ) = dq) THEN inquotes := ~inquotes;
- IF inquotes THEN first := TRUE; tokenval := msopenquo ELSE tokenval := msclosequo END
- ELSE
- IF inquotes THEN
- tokenval := literal; first := FALSE; RETURN ch
- ELSE
- CASE ch OF
- "X" : ch := GetCh();
- IF ( "0" <= ch ) & ( ch <= "9" ) THEN tokenval := mssubexpr; RETURN ch END|
- "t" : tokenval := shorthand; RETURN CHR( tab ) |
- "c" : tokenval := shorthand; RETURN CHR( cr ) |
- ELSE
- END
- END;
- IF ~EORPL THEN error := wsubexpr END
- END;
- RETURN ch
- END LexAn;
- PROCEDURE Append( chr : CHAR );
- BEGIN
- IF lineind < LEN( line ) THEN line[lineind] := chr; INC(lineind); linefull := FALSE ELSE linefull := TRUE END
- END Append;
- BEGIN
- IF dfa # NIL THEN
- (*IF LEN( line ) > noofchar THEN error := linecopofl; RETURN ELSE*) COPY( line, linecop ) (*END*);
- replind := 0; lineind := beg; linefull := FALSE; inquotes := FALSE; first := FALSE; error := noerror;
- ch := LexAn();
- WHILE (~linefull) & ( ~ EORPL ) & ( error = noerror ) DO
- CASE tokenval OF
- msopenquo : ch := LexAn();
- WHILE ( tokenval # msclosequo ) & ( ~EORPL ) DO
- Append( ch ); ch := LexAn()
- END;
- IF tokenval # msclosequo THEN error := dq END |
- mssubexpr : ind := ORD(ch) - ORD("0");
- IF dfa.sub[ind].end # undefined THEN
- spos := dfa.sub[ind].beg;
- WHILE (spos < dfa.sub[ind].end) DO Append( linecop[spos] ); INC(spos ) END
- END |
- shorthand : Append( ch )
- ELSE
- END;
- ch := LexAn()
- END;
- IF error = noerror THEN
- pos := lineind;
- spos := end;
- WHILE ( spos < LEN( linecop ) ) & ( linecop[spos] # 0X ) DO Append( linecop[spos] ); INC( spos ) END;
- IF lineind < LEN( line ) THEN Append( CHR(0) ) END;
- IF linefull THEN error := repllinefull ELSE RETURN END
- END;
- ELSE
- error := nodfa
- END;
- pos := replind;
- COPY( linecop, line )
- END Replace;
- END RXA.
-